unit udmsrv;

{$mode ObjFPC}{$H+}

interface

uses
  Classes,
  SysUtils,
  FileUtil,
  Printers,
  DOM,
  XMLRead,
  XMLUtils,
  gettext,
  LCLTranslator,
  DefaultTranslator,
  mormot.core.Text,
  mormot.core.os,
  mormot.core.perf,
  mormot.core.variants,
  mormot.core.unicode,
  mormot.DB.sql,
  mormot.DB.sql.sqlite3,
  mormot.DB.raw.sqlite3,
  mormot.DB.raw.sqlite3.static,
  RegExpr,
  rtcInfo,
  rtcSystem,
  rtcConn,
  rtcHttpSrv,
  rtcDataSrv,
  UniqueInstance;

type

  { Tdmsrv }

  Tdmsrv = class(TDataModule)
    rtcdp: TRtcDataProvider;
    rtchs: TRtcHttpServer;
    ui: TUniqueInstance;
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
    procedure rtcdpCheckRequest(Sender: TRtcConnection);
    procedure rtcdpDataReceived(Sender: TRtcConnection);
    procedure rtchsListenStart(Sender: TRtcConnection);
    procedure rtchsListenStop(Sender: TRtcConnection);
  private
    function doXml(const axml: string): string;
    function doWeixinGet(Query: TRtcHttpValues): string;
    function doWeixinPost(Query: TRtcHttpValues): string;
    function doPrinters(Query: TRtcHttpValues): string;
    function doPrint(Query: TRtcHttpValues): string;
  public
    procedure srvStart;
    procedure srvStop;
  end;


var
  dmsrv: Tdmsrv;
  gPath: string;
  gProps: TSqlDBSQLite3ConnectionProperties;

implementation

{$R *.lfm}

{ Tdmsrv }

uses
  ufrmmain,
  ulngres;

procedure Tdmsrv.rtchsListenStart(Sender: TRtcConnection);
begin
  doLog(strSrvStart);
end;

procedure Tdmsrv.DataModuleCreate(Sender: TObject);
begin
  srvStart;
end;

procedure Tdmsrv.DataModuleDestroy(Sender: TObject);
begin
  srvStop;
end;

procedure Tdmsrv.rtcdpCheckRequest(Sender: TRtcConnection);
begin
  Sender.Accept;
end;

procedure Tdmsrv.rtcdpDataReceived(Sender: TRtcConnection);
begin
  with Sender, request do
  begin
    if (FileName = '/') and (Method = 'GET') then
      Write(ReadFileToString('.\wwwroot\index.html'))
    else if (FileName = '/weixin') and (Method = 'GET') then
      Write(doWeixinGet(Query))
    else if (FileName = '/weixin') and (Method = 'POST') then
    begin
      Query.AddText(doxml(Sender.Read));
      Write(doweixinpost(Query));
    end
    else if (FileName = '/printers') and (Method = 'GET') then
      Write(doPrinters(Query))
    else if (FileName = '/print') and (Method = 'POST') then
    begin
      Query.Value['filepath'] :=
        Format('%s\upload\%s\%d%s', [exeversion.ProgramFilePath,
        FormatDateTime('yyyymmdd', now), GetTickCount64,
        ExtractFileExt(Request.Info.asText['file'])]);
      ForceDirectories(Query.Value['filepath']);
      Write(Query.Value['filepath']);
    end;
  end;
end;

procedure Tdmsrv.rtchsListenStop(Sender: TRtcConnection);
begin
  doLog(strSrvStop);
end;

function Tdmsrv.doXml(const axml: string): string;
var
  XMLDoc: TXMLDocument;
  Stream: TStringStream;
  i: integer;
  Node: TDOMNode;
  NodeName, NodeContent: string;
  ResultList: TStringList; // 用于方便地拼接字符串
begin
  Result := '';
  ResultList := TStringList.Create;
  Stream := TStringStream.Create(axml);
  try
    try
      ReadXMLFile(XMLDoc, Stream); // 解析XML字符串
      // 获取根节点 (xml) 的所有子节点
      if Assigned(XMLDoc.DocumentElement) then
      begin
        for i := 0 to XMLDoc.DocumentElement.ChildNodes.Count - 1 do
        begin
          Node := XMLDoc.DocumentElement.ChildNodes[i];
          NodeName := Node.NodeName; // 获取标签名称

          NodeContent := '';
          // 提取节点内容，处理CDATA或普通文本
          if Assigned(Node.FirstChild) then
          begin
            if Node.FirstChild is TDOMCDATASection then
              NodeContent := Node.FirstChild.TextContent // 获取CDATA内容
            else
              NodeContent := Node.TextContent; // 获取普通文本内容
          end;

          // 将 "名称=内容" 添加到列表中
          ResultList.Add(NodeName + '=' + NodeContent);
        end;
      end;
      // 使用 '&' 连接列表中的所有字符串
      Result := ResultList.DelimitedText;
      // TStringList 的 DelimitedText 默认使用引号处理，这里我们直接替换并确保以'&'分隔
      // 更简单的方式是使用自定义连接
      Result := StringReplace(ResultList.Text, LineEnding, '&', [rfReplaceAll]);
      // 去除末尾可能多余的'&'
      if Result <> '' then
        Result := '&' + TrimRight(Result);
    finally
      XMLDoc.Free; // 释放XML文档
    end;
  finally
    Stream.Free; // 释放流
    ResultList.Free; // 释放字符串列表
  end;
end;

function Tdmsrv.doWeixinGet(Query: TRtcHttpValues): string;
begin
  doLog(strWeixinMessage + ':' + Query.Text);
  Result := Query.AsString['echostr'];
end;

function Tdmsrv.doWeixinPost(Query: TRtcHttpValues): string;
begin
  doLog(strWeixinMessage + ':' + Query.Text);
  with Query do
  begin
    if Value['Content'] = '菜单' then;

  end;
  Result := Query.AsString['echostr'];
end;

function Tdmsrv.doPrinters(Query: TRtcHttpValues): string;
begin
  Result := '["' + Printer.Printers.Text.Replace(#13#10, '","', [rfReplaceAll]) + '"]';
end;

function Tdmsrv.doPrint(Query: TRtcHttpValues): string;
begin

end;

procedure Tdmsrv.srvStart;
begin
  gProps := TSqlDBSQLite3ConnectionProperties.Create('ahprt.db3', '', '', '');
  rtchs.Listen();
end;

procedure Tdmsrv.srvStop;
begin
  gProps.ExecuteNoResult('VACUUM', []);
  CopyFile(gProps.servername, changefileext(gProps.servername,
    FormatDateTime('_yyyymmddhhnnss', now) + '.db3'), True);
  gProps.Free;
  rtchs.StopListenNow();
end;

end.
